Covid19 Japanが独自に収集している陽性確定者単位のデータ。ソースとデータは全てGitHubにて公開されているが、データはJSON形式である点に注意。発表後に修正されたレコード(インスタンス)は削除されれずにステータスなどが変更されているだけなので、「レコード数 \(\neq\) 累計陽性確定者」である点に注意。
Covid19 JapanがGitHubで公開しているデータはJSOM形式のため、また、最新データがインデックスで示されているため、読み込むには少し工夫が必要である。
陽性者単位のデータ。
path <- "https://raw.githubusercontent.com/reustle/covid19japan-data/master/docs/patient_data/"
data_at <- readr::read_lines(paste0(path, "latest.json")) %>%
stringr::str_sub(start = 1L, end = -6L)
df <- path %>%
paste0("latest.json") %>%
readr::read_lines() %>%
paste0(path, .) %>%
jsonlite::fromJSON()
df
死亡者数や重症者数などの推移データはsummaryフォルダ内のJSON形式ファイルにまとめられている。summaryフォルダの他にsummary_minフォルダというフォルダがあるが、summary_minフォルダ内のJSONファイルは改行を省略した形式のファイル。
path <- "https://raw.githubusercontent.com/reustle/covid19japan-data/master/docs/summary/"
df_s <- path %>%
paste0("latest.json") %>%
readr::read_lines() %>%
paste0(path, .) %>%
jsonlite::fromJSON()
df_s %>% summary()
## Length Class Mode
## prefectures 27 data.frame list
## regions 12 data.frame list
## daily 37 data.frame list
## updated 1 -none- character
要約すると分かるが、3つのデータフレームと一つのベクトルから構成されている。参考までに各データの内容を簡単に紹介する。
厳密には都道府県+空港検疫・ダイヤモンドプリンセス・長崎クルーズ船・その他の51区分になっておえい、一部の変量(フィーチャー)がネストされている。
df_s$prefectures
prefs <- "https://gist.githubusercontent.com/k-metrics/9f3fc18e042850ff24ad9676ac34764b/raw/bcf237d21ace39eb74adafe76d6cb1d5c463d31e/pref_utf8.csv" %>%
readr::read_csv() %>%
dplyr::rename(pcode = `コード`) %>%
dplyr::mutate(pref = stringr::str_to_title(pref),
pcode = forcats::fct_inorder(pcode),
fct_pref = forcats::fct_inorder(pref),
`都道府県` = forcats::fct_inorder(`都道府県`),
`八地方区分` = forcats::fct_inorder(`八地方区分`),
`広域圏` = forcats::fct_inorder(`広域圏`),
`通俗的区分` = forcats::fct_inorder(`通俗的区分`))
df_s$prefectures %>%
dplyr::select(dailyDeceasedCount, dailyDeceasedStartDate, name) %>%
dplyr::mutate(dailyDeceasedStartDate = lubridate::as_date(dailyDeceasedStartDate)) %>%
tidyr::unnest(cols = dailyDeceasedCount) %>%
dplyr::group_by(name) %>%
dplyr::summarise(n = sum(dailyDeceasedCount))
# %>% print() %>%
# dplyr::left_join(prefs, by = c("name" = "pref")) %>%
# dplyr::group_by(`八地方区分`) %>%
# dplyr::summarise(dead = sum(n))
df_s$prefectures %>%
dplyr::select(deceased, name) %>%
dplyr::arrange(name)
いわゆる八地方区分単位で集計されているデータ。こちらも都道府県単位集計と同様に一部の変量(フィーチャー)がネストされている。ただし、ネストされている変量(フィーチャー)を展開して集計しても集計値とは異なるので、現時点では利用できない。
df_s$regions
発表があった日毎にまとめているデータ。最初の行(インスタンス、レコード)の日付がおかしい点に注意(他のデータから推測すると恐らく“2020-01-08”)。
df_s$daily
集計データファイル(JSON形式)の更新日時が記録されている。
df_s$updated
## [1] "2020-11-01T21:10:35+09:00"
まず、オリジナルのデータがどのようになっているかskimrパッケージを用いてサマライズしておく。
df %>%
skimr::skim()
| Name | Piped data |
| Number of rows | 103586 |
| Number of columns | 23 |
| _______________________ | |
| Column type frequency: | |
| character | 19 |
| logical | 3 |
| numeric | 1 |
| ________________________ | |
| Group variables | None |
Variable type: character
| skim_variable | n_missing | complete_rate | min | max | empty | n_unique | whitespace |
|---|---|---|---|---|---|---|---|
| patientId | 0 | 1.00 | 1 | 8 | 0 | 101942 | 0 |
| dateAnnounced | 0 | 1.00 | 10 | 10 | 0 | 278 | 0 |
| gender | 14078 | 0.86 | 1 | 1 | 0 | 2 | 0 |
| detectedPrefecture | 0 | 1.00 | 3 | 15 | 0 | 49 | 0 |
| patientStatus | 99642 | 0.04 | 8 | 23 | 0 | 8 | 0 |
| notes | 53601 | 0.48 | 1 | 270 | 0 | 47225 | 1 |
| mhlwPatientNumber | 103137 | 0.00 | 1 | 11 | 0 | 434 | 0 |
| prefecturePatientNumber | 12002 | 0.88 | 5 | 20 | 0 | 91575 | 0 |
| prefectureSourceURL | 72282 | 0.30 | 5 | 224 | 0 | 3439 | 0 |
| residence | 22021 | 0.79 | 1 | 38 | 0 | 1421 | 0 |
| sourceURL | 637 | 0.99 | 1 | 239 | 0 | 7904 | 0 |
| relatedPatients | 93313 | 0.10 | 2 | 259 | 0 | 6293 | 0 |
| knownCluster | 101108 | 0.02 | 3 | 88 | 0 | 229 | 0 |
| detectedCityTown | 77744 | 0.25 | 2 | 22 | 0 | 663 | 0 |
| cityPrefectureNumber | 78056 | 0.25 | 1 | 34 | 0 | 25521 | 2 |
| citySourceURL | 91757 | 0.11 | 9 | 317 | 0 | 3636 | 0 |
| deceasedDate | 101801 | 0.02 | 5 | 10 | 0 | 229 | 0 |
| deceasedReportedDate | 102376 | 0.01 | 10 | 62 | 0 | 203 | 0 |
| deathSourceURL | 102518 | 0.01 | 14 | 123 | 0 | 650 | 0 |
Variable type: logical
| skim_variable | n_missing | complete_rate | mean | count |
|---|---|---|---|---|
| confirmedPatient | 0 | 1 | 0.98 | TRU: 101941, FAL: 1645 |
| charterFlightPassenger | 103572 | 0 | 1.00 | TRU: 14 |
| cruisePassengerDisembarked | 103575 | 0 | 1.00 | TRU: 11 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| ageBracket | 0 | 1 | 32.67 | 23.57 | -1 | 20 | 30 | 50 | 100 | ▅▇▅▂▁ |
元がJSON形式なので、読み込んだ直後は殆どの変量(フィーチャー)が文字型になっていることが分かる。また、意外と欠損が多いことも分かるので、欠損が非常に多い変量は除いておくことにする。
各変量(フィーチャー)を適切な形式に変換し、地域区分でも分析できるように都道府県データと結合します。
x <- df %>%
dplyr::select(patientId, date = dateAnnounced, gender,
pref = detectedPrefecture, patientStatus, knownCluster,
confirmedPatient, charterFlightPassenger,
cruisePassengerDisembarked, ageBracket,
deceasedDate, deceasedReportedDate) %>%
dplyr::filter(confirmedPatient == TRUE) %>%
dplyr::mutate(date = lubridate::as_date(date),
gender = forcats::as_factor(gender),
patientStatus = forcats::as_factor(patientStatus),
cluster = dplyr::if_else(!is.na(knownCluster), TRUE, FALSE),
ageBracket = forcats::as_factor(ageBracket),
deceasedDate = lubridate::as_date(deceasedDate),
deceasedReportedDate = lubridate::as_date(deceasedReportedDate)) %>%
dplyr::left_join(prefs, by = c("pref" = "pref"))
## Warning: Problem with `mutate()` input `deceasedReportedDate`.
## ℹ 2 failed to parse.
## ℹ Input `deceasedReportedDate` is `lubridate::as_date(deceasedReportedDate)`.
## Warning: 2 failed to parse.
x
x %>%
skimr::skim()
| Name | Piped data |
| Number of rows | 101941 |
| Number of columns | 19 |
| _______________________ | |
| Column type frequency: | |
| character | 3 |
| Date | 3 |
| factor | 9 |
| logical | 4 |
| ________________________ | |
| Group variables | None |
Variable type: character
| skim_variable | n_missing | complete_rate | min | max | empty | n_unique | whitespace |
|---|---|---|---|---|---|---|---|
| patientId | 0 | 1.00 | 1 | 8 | 0 | 101941 | 0 |
| pref | 0 | 1.00 | 3 | 15 | 0 | 49 | 0 |
| knownCluster | 99492 | 0.02 | 3 | 88 | 0 | 227 | 0 |
Variable type: Date
| skim_variable | n_missing | complete_rate | min | max | median | n_unique |
|---|---|---|---|---|---|---|
| date | 0 | 1 | 2020-01-15 | 2020-11-01 | 2020-08-12 | 278 |
| deceasedDate | 101562 | 0 | 2020-02-13 | 2020-10-17 | 2020-05-08 | 150 |
| deceasedReportedDate | 101611 | 0 | 2020-02-13 | 2020-10-17 | 2020-05-16 | 131 |
Variable type: factor
| skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
|---|---|---|---|---|---|
| gender | 13450 | 0.87 | FALSE | 2 | M: 49713, F: 38778 |
| patientStatus | 99408 | 0.02 | FALSE | 8 | Hos: 1261, Dec: 371, Hom: 315, Dis: 283 |
| ageBracket | 0 | 1.00 | FALSE | 13 | 20: 24359, 30: 15357, -1: 13546, 40: 12687 |
| pcode | 1195 | 0.99 | FALSE | 47 | 13: 31236, 27: 12876, 14: 8790, 23: 6282 |
| 都道府県 | 1195 | 0.99 | FALSE | 47 | 東京都: 31236, 大阪府: 12876, 神奈川: 8790, 愛知県: 6282 |
| 八地方区分 | 1195 | 0.99 | FALSE | 8 | 関東地: 53135, 近畿地: 20254, 九州地: 10890, 中部地: 9863 |
| 広域圏 | 7755 | 0.92 | FALSE | 8 | 首都圏: 53351, 近畿圏: 19689, 中部圏: 8536, 九州圏: 7524 |
| 通俗的区分 | 1195 | 0.99 | FALSE | 11 | 関東: 53135, 関西: 19689, 東海: 8194, 九州: 7524 |
| fct_pref | 1195 | 0.99 | FALSE | 47 | Tok: 31236, Osa: 12876, Kan: 8790, Aic: 6282 |
Variable type: logical
| skim_variable | n_missing | complete_rate | mean | count |
|---|---|---|---|---|
| confirmedPatient | 0 | 1 | 1.00 | TRU: 101941 |
| charterFlightPassenger | 101927 | 0 | 1.00 | TRU: 14 |
| cruisePassengerDisembarked | 101930 | 0 | 1.00 | TRU: 11 |
| cluster | 0 | 1 | 0.02 | FAL: 99492, TRU: 2449 |
文字型を因子型に変換するだけでも大まかな傾向が見える。例えば
ことが読める。
parientStatusは症状(状態)と状況が混在しているため、分かりにくいが以下の通りである。なお、Unspecifiedとは別に欠損値(NA)もある。
| levels | 意味 |
|---|---|
| Hospitalized | 入院中 |
| Critical (Hospitalized) | 重症(入院中) |
| Home Quarantine | 自宅療養中 |
| Hotel Quarantine | ホテル療養中 |
| Recoverd | 回復 |
| Discharged | 退院済 |
| Deceased | 死亡 |
| Unspecified | 詳細不明 |
x %>%
dplyr::group_by(pref) %>%
dplyr::summarise(n = n())
x %>%
dplyr::group_by(date, `八地方区分`) %>%
dplyr::summarise(n = n()) %>%
dplyr::ungroup() %>%
tidyr::pivot_wider(names_from = `八地方区分`, values_from = n) %>%
dplyr::rename(`その他` = "NA") %>%
tidyr::complete(date = seq.Date(from = lubridate::as_date("2020-01-08"),
to = max(date), by = "day")) %>%
tidyr::pivot_longer(cols = -date, names_to = "regions", values_to = "n") %>%
tidyr::replace_na(list(n = 0L)) %>%
tidyr::pivot_wider(names_from = regions, values_from = n) %>% print() %>%
dplyr::summarise_if(is.integer, .funs = sum)
## # A tibble: 299 x 10
## date 関東地方 中部地方 北海道地方 近畿地方 その他 九州地方 四国地方
## <date> <int> <int> <int> <int> <int> <int> <int>
## 1 2020-01-08 0 0 0 0 0 0 0
## 2 2020-01-09 0 0 0 0 0 0 0
## 3 2020-01-10 0 0 0 0 0 0 0
## 4 2020-01-11 0 0 0 0 0 0 0
## 5 2020-01-12 0 0 0 0 0 0 0
## 6 2020-01-13 0 0 0 0 0 0 0
## 7 2020-01-14 0 0 0 0 0 0 0
## 8 2020-01-15 1 0 0 0 0 0 0
## 9 2020-01-16 0 0 0 0 0 0 0
## 10 2020-01-17 0 0 0 0 0 0 0
## # … with 289 more rows, and 2 more variables: 東北地方 <int>, 中国地方 <int>